home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / horse.bas < prev    next >
BASIC Source File  |  1990-08-20  |  3KB  |  111 lines
  1.  '******************************************************************************
  2.  '* HORSE -- Animation demo using PSET option.                                 *
  3.  '*                                                                            *
  4.  '* Written for GRAFIX by:  Joseph A. Albrecht                                 *
  5.  '*                                                                            *
  6.  '* Press F1 to change foreground color                                        *
  7.  '* Press F2 to change background color                                        *
  8.  '* Press F3 to restart program                                                *
  9.  '* Press F10 to toggle between 320 and 640 graphic modes                      *
  10.  '* Press ESC to exit program                                                  *
  11.  '******************************************************************************
  12.  '$INCLUDE: 'GRAFQBS.INC' 
  13.  'The above line is for QuickBASIC.
  14.  
  15.  ''$INCLUDE "GRAFTBS.INC"
  16.  'The above line is for TURBO BASIC. Remove the  ''  to compile the program.
  17.  
  18.  ''$INCLUDE "GRAFPBS.INC"
  19.  'The above line is for PowerBASIC. Remove the  ''  to compile the program.
  20.  
  21.  DIM H1(354), H2(354), H3(354), H4(354), H5(354)
  22.  
  23.  DEF SEG = VARSEG(H1(0))
  24.  BLOAD "HORSE1.BIN", VARPTR(H1(0))
  25.  DEF SEG = VARSEG(H2(0))
  26.  BLOAD "HORSE2.BIN", VARPTR(H2(0))
  27.  DEF SEG = VARSEG(H3(0))
  28.  BLOAD "HORSE3.BIN", VARPTR(H3(0))
  29.  DEF SEG = VARSEG(H4(0))
  30.  BLOAD "HORSE4.BIN", VARPTR(H4(0))
  31.  DEF SEG = VARSEG(H5(0))
  32.  BLOAD "HORSE5.BIN", VARPTR(H5(0))
  33.  
  34.  CALL GetTandy11(Tandy11%)
  35.  CALL MediumGraphics
  36.  Graphics = 320
  37.  FC = White
  38.  BC = Blue
  39.  X1 = 2
  40.  X2 = 158
  41.  
  42.  ' 
  43.  ' --- Prints Image Arrays Onto Screen ---
  44.  ' 
  45. Again:
  46.  CALL SetPalette(15, FC)
  47.  CALL SetBackColor(BC)
  48.  
  49. PutImage:
  50.  FOR Q = X1 TO X2 STEP 52
  51.    CALL ExtPut(Q + 54, 85, H1(0), PutPset)
  52.  NEXT Q
  53.  FOR Q = X1 TO X2 STEP 52
  54.    CALL ExtPut(Q + 54, 85, H2(0), PutPset)
  55.  NEXT Q
  56.  FOR Q = X1 TO X2 STEP 52
  57.    CALL ExtPut(Q + 54, 85, H3(0), PutPset)
  58.  NEXT Q
  59.  FOR Q = X1 TO X2 STEP 52
  60.    CALL ExtPut(Q + 54, 85, H4(0), PutPset)
  61.  NEXT Q
  62.  FOR Q = X1 TO X2 STEP 52
  63.    CALL ExtPut(Q + 54, 85, H5(0), PutPset)
  64.  NEXT Q
  65.  K$ = INKEY$
  66.  K$ = RIGHT$(K$, 1)
  67.  IF K$ = CHR$(27) THEN
  68.    CALL ExitGraphics
  69.    END
  70.  END IF
  71.  IF K$ = CHR$(68) AND Tandy11% = Tandy11.True% THEN
  72.    IF Graphics = 320 THEN
  73.      Graphics = 640
  74.      X1 = 162
  75.      X2 = 318
  76.      CALL HighGraphics
  77.      GOTO Again
  78.    ELSE
  79.      Graphics = 320
  80.      X1 = 2
  81.      X2 = 158
  82.      CALL MediumGraphics
  83.      GOTO Again
  84.    END IF
  85.  END IF
  86.  IF K$ = CHR$(59) THEN GOSUB ChangeForColor
  87.  IF K$ = CHR$(60) THEN GOSUB ChangeBackColor
  88.  IF K$ = CHR$(61) THEN
  89.     FC = White
  90.     BC = Blue
  91.     GOTO Again
  92.  END IF
  93.  GOTO PutImage
  94.  
  95.  ' 
  96.  ' --- Change Colors ---
  97.  ' 
  98. ChangeForColor:
  99.  FC = FC + 1
  100.  IF FC > 15 THEN FC = 1
  101.  IF FC = BC THEN GOTO ChangeForColor
  102.  CALL SetPalette(15, FC)
  103.  RETURN
  104.  
  105. ChangeBackColor:
  106.  BC = BC + 1
  107.  IF BC > 15 THEN BC = 0
  108.  IF BC = FC THEN GOTO ChangeBackColor
  109.  CALL SetBackColor(BC)
  110.  RETURN
  111.